Introducción

Descripción

¿Qué datos son?

La base posee datos sobre diferentes vinos y sus reseñas. El detalle de los datos se transcribe del diccionario:

diccionario <- data.frame(
  Variable = c("pais", "nombre", "puntos", "precio", "provincia", "zona_1", "zona_2", "variedad", "vina", "titulo_resena"),
  Clase = c("caracter", "caracter", "entero", "entero", "caracter", "caracter", "caracter", "caracter", "caracter", "caracter"),
  Descripción = c("País de origen", "Nombre del vino", "Puntos con que fue calificado (1 a 100)", "Precio de la botella (en dólares)", 
                  "Lugar de origen", "Información adicional sobre zona de origen", "Más información adicional", 
                  "Variedad (ie, Pinot Noir)", "Nombre de la viña", "Título de la reseña")
)
dicc_url = "https://github.com/cienciadedatos/datos-de-miercoles/tree/master/datos/2019/2019-06-12"
dicc_pie = "Fuente: '<a href=\"dicc_url\">Datos de Miércoles</a>', proyecto semanal de datos organizado por la comunidad de R."

diccionario |>
  gt(rowname_col = "Variable") |>
  tab_options(table.width = "75%") |> 
  opt_stylize(style = 5, color = 'green') |> 
  # tab_stubhead(label = "Variable") |> 
  # gt_theme_dark() |> 
  tab_source_note(html(dicc_pie))
Clase Descripción
pais caracter País de origen
nombre caracter Nombre del vino
puntos entero Puntos con que fue calificado (1 a 100)
precio entero Precio de la botella (en dólares)
provincia caracter Lugar de origen
zona_1 caracter Información adicional sobre zona de origen
zona_2 caracter Más información adicional
variedad caracter Variedad (ie, Pinot Noir)
vina caracter Nombre de la viña
titulo_resena caracter Título de la reseña
Fuente: 'Datos de Miércoles', proyecto semanal de datos organizado por la comunidad de R.

Origen

¿De dónde provienen?

La fuente de los datos es la revista Wine Enthusiast, extraidos por zackthoutt y alojados en Kaggle, de donde fueron tomados y luego traducidos.

¿Quién los tomó?

Imagen

Fecha

¿En qué período se tomaron?

El dataset en español es de 2019-06-12 (dato obtenido de la url de origen del dataset).

El original en inglés de Keggle fue actualizado por última vez hace 5 años (2018), pero no se indica la fecha exacta de procedencia de los datos.

Análisis

Exploración de los datos

Muestreo

Primero se cargan los datos:

vinos  <-  read_csv('datos/vinos.csv', show_col_types = FALSE)

Luego se presenta una muestra:

sample_n(vinos, 5) |>
  gt() |> 
  # tab_options(table.background.color = "#25303f",
  #             heading.background.color = "#003258") |> 
  gt_theme_pff() |>
  # gt_highlight_cols(columns = c(puntos,precio), fill = "#e4e8ec")  |> 
  tab_header(title = "Reseñas de Vinos") |>
   tab_footnote(
    footnote = "Muestra aleatoria de 5 registros.",
    locations = cells_title("title")) |> 
  tab_source_note(
    source_note = html("Fuente: Revista <a href=\"www.wineenthusiast.com\">Wine Enthusiast</a>."))
Reseñas de Vinos1
pais nombre puntos precio provincia region_1 region_2 variedad vina titulo_resena
Estados Unidos NA 84 38 California Russian River Valley Sonoma Pinot Noir Desmond Desmond 2009 Pinot Noir (Russian River Valley)
Francia NA 89 36 Burgundy Meursault NA Chardonnay Olivier Leflaive Olivier Leflaive 2012 Meursault
Argentina Vino de Parcela Única 88 60 Otra Patagonia NA Trousseau Aniello Aniello 2014 Vino de Parcela Única Trousseau (Patagonia)
Estados Unidos Martinelli 89 60 California Paso Robles Central Coast Zinfandel Lone Madrone Lone Madrone 2012 Martinelli Zinfandel (Paso Robles)
Chile Expedicion 85 12 Valle de Maule NA NA Cabernet Sauvignon Finca Patagonia Finca Patagonia 2015 Expedicion Cabernet Sauvignon (Maule Valley)
Fuente: Revista Wine Enthusiast.
1 Muestra aleatoria de 5 registros.

Se almacenan las dimensiones de la base en variables:

observaciones <- nrow(vinos)
variables <- ncol(vinos)

El dataset tiene 129971 observaciones y 10 variables.

Variables a analizar

Se consideran las variables puntos y precio para el análisis, ya que son las únicas numéricas, por lo que permiten mayores análisis que el resto de las variables del dataset, que son categóricas.

Tendencia Central

¿Cuál es su valor medio y desvío estándar?

Medidas de Tendencia Central
Media Mediana Moda Desvío
Puntos 88.45 88 88 3.04
Precio 35.36 25 20 41.02

Puntos

Por la media y el desvío, se puede estimar, asumiendo que las calificaciones tienen distribución normal, que el 68% de la muestra se encuentra entre 85 y 91 puntos.

La similitud entre media, mediana y moda permite suponer una distribución, si no normal, al menos simétrica.

Precio

Por la media y el desvío, se puede suponer que la distribución no es normal.

La diferencia entre moda, mediana y media, confirma esto, permitiendo estimar una distribución asimétrica hacia la derecha.

Rango

¿Cuál es su rango (valor máximo y valor mínimo)?

pts_rng <- summarise(vinos, 
                     min = min(puntos, na.rm = TRUE),
                     max = max(puntos, na.rm = TRUE))

pre_rng <- summarise(vinos,
                     min = min(precio, na.rm = TRUE),
                     max = max(precio, na.rm = TRUE))

rng <- rbind(pts_rng, pre_rng) |>
  add_column("variable" = c("Puntos","Precio"),
             .before = "min") |>
  gt(rowname_col = 'variable') |>
  tab_header(
    title = "Rango") |>
  cols_label(min = "Mínimo",
             max = "Máximo") |>
  opt_stylize(style = 2, color = 'blue')
rng
Rango
Mínimo Máximo
Puntos 80 100
Precio 4 3300

Puntos

Puede observarse que los puntos no bajan de 80, por lo que la calificación oscila en un rango de solo 20 puntos.

Precio

Se confirma que los precios altos tienen gran dispersión y se alejan mucho de la media, lo que ratifica una asimetría hacia la derecha.

Anomalías

¿Hay alguna anomalía que sugiera que hay datos incorrectos?

No hay evidencias de que existan anomalías en los datos, solo algunos valores llamativos, como la diferencia entre la media de precios y los precios máximos, ya que, aunque el máximo es US$3300, solo existen 1177 (de un total de 129971) que superen los US$158 (promedio de precio + 3 desvíos estándar).

También llamó la atención la cantidad de cepas o variedades de vino (707), pero únicamente porque superó ampliamente el número esperado.

La dispersión de precios puede observarse mejor mediante un gráfico:

theme_set(theme_dark() + 
            theme(plot.background = element_rect(fill = "#555555"),
                  axis.text = element_text(color = "#222222"),
                  legend.background = element_rect(fill = "#888888")
                  ))
p <- vinos |>
  filter(precio <= precio_caro) |>
  ggplot() + 
  geom_histogram(binwidth = 3, 
                 show.legend = FALSE, 
                 aes(x = precio,fill = cut(precio, 100))) +
  scale_fill_viridis_d(option = "A", direction = -1) +
  labs(title = "Histograma de Precios",
       x = "Precio (US$)", 
       y = "Cantidad de Reseñas")

#ver https://community.rstudio.com/t/geom-histogram-max-bin-height/10026
#ver https://github.com/tidyverse/ggplot2/issues/5004
cuspide <- select(layer_data(p)[which.max(layer_data(p)$y), ],x,y)

# Añade la marca y la nota al pie
p <- p +
  geom_text(data = cuspide,
            aes(x = x, y = y,
                label = paste0("Cúspide\nUS$", x, "\n", y," reseñas")),
            nudge_x = 2, nudge_y = -500, color = "#333333", hjust = 0) + 
  geom_point(data = cuspide, 
             aes(x = x, y = y),
             shape = 20, size = 3, fill = NA, color = "#333333") +
  annotate("text", x = Inf, y = Inf, hjust = 1, vjust = 1, 
           label = paste0("Las reseñas de valores mayores a ",
                         paste0("$", round(precio_caro,2)), " fueron omitidas."),
           color = "#333333")  # Nota en la parte superior del área del gráfico

show(p)

Histograma de dispersión de precios. El eje X indica el precio en dólares, y el Y la cantidad de reseñas; posee una cúspide de 12828 reseñas para los vinos de precio cercano a 15 dólares, con una marcada asimetría hacia la derecha, por lo que se filtraron valores mayores a 160 dólares.

(los precios mayores a 158 fueron excluidos)

Tamaño

¿Cuántas observaciones hay por cada grupo? ¿Cuántos valores faltantes? ¿Hay diferencias?

Se contabiliza el porcentaje de valores N/A (vacíos), para cada una de las variables:

proporcion <- tibble::rownames_to_column(data.frame(colSums(is.na(vinos))/nrow(vinos)),
                                                  "variable")
colnames(proporcion)[2] <- "Cantidad de NA"
proporcion |> 
gt() |>
  gt_theme_pff() |>
  fmt_percent(columns = 2, decimals = 2)
variable Cantidad de NA
pais 0.05%
nombre 28.83%
puntos 0.00%
precio 6.92%
provincia 0.05%
region_1 16.35%
region_2 61.14%
variedad 0.00%
vina 0.00%
titulo_resena 0.00%

Pueden encontrarse bastantes valores faltantes, pero únicamente en las columnas de nombre (28.83%), region_1 (16.35%) y region_2 (61.14%).

Hipótesis

Se presentan 3 hipótesis:

  1. Podría existir una diferencia notable entre el promedio de precios de los vinos según el país.
  2. Habría una incremento en el precio promedio del vino conforme su puntaje.
  3. Existirían variedades que podrían tener un precio promedio significativamente mayor, pero no así su puntaje.

Precio x Pais

Podría existir una diferencia notable entre el promedio de precios de los vinos según el país.

Para analizar esto, primero, se realiza un gráfico para ver los promedios de precio x país:

# https://sebastiansauer.github.io/figure_sizing_knitr/

paleta_pais <- createPalette(43,  c("#ff0000", "#00ff00", "#0000ff")) # paleta personalizada

vinos |> 
  filter(!is.na(pais)) |> 
  group_by(pais) |> 
  summarise(precio_promedio = mean(precio, na.rm = TRUE)) |>
  filter(!is.na(precio_promedio)) |>
  ggplot(aes(precio_promedio, reorder(pais, precio_promedio))) +
  geom_col(width = 0.5, alpha = 0.6, show.legend = FALSE,
           aes(fill = reorder(pais, precio_promedio),
               color=reorder(pais, precio_promedio))) +
  scale_fill_viridis_d(aesthetics = c("colour", "fill")) +
  scale_x_continuous(expand = c(0.01,0)) + 
  # scale_colour_manual(values = paleta_pais,aesthetics = c("colour", "fill")) + #no logré que funcione
  labs(title = "Precio promedio de los vinos por pais",
       subtitle = "Listado completo",
       x = "Precio", y = "Pais")

Se ve una gran dispersión, con precios que van desde menos de US$10 (Ucrania), hasta más de US$85 (Suiza).

Para verificar que estos promedios sean estadísticamente significativos, se analiza cuantas reseñas hay de cada pais:

vinos |> 
  filter(!is.na(pais)) |> 
  group_by(pais) |> 
  summarise(resenias = n()) |>
  arrange(resenias) |>
  head(10) |> 
  gt() |> 
  tab_header(title = "Paises con menos reseñas") |>
  cols_label(pais = "País", resenias = "Reseñas") |> 
  gt_theme_dark()
Paises con menos reseñas
País Reseñas
China 1
Egipto 1
Eslovaquia 1
Armenia 2
Bosnia y Herzegovina 2
Luxemburgo 6
Suiza 7
India 9
Chipre 11
Macedonia 12

Destacan varios paises casi sin reseñas. Gráficamente:

vinos |> 
  filter(!is.na(pais)) |> 
  group_by(pais) |> 
  summarise(resenias = n()) |>
  ggplot(aes(resenias, reorder(pais, resenias))) +
  geom_col(width = 0.5, show.legend = FALSE, 
           aes(color=reorder(pais, resenias),
           fill=reorder(pais, resenias), 
           alpha = 0.6)) +
  scale_fill_viridis_d(option = "A", 
                       direction = 1, 
                       aesthetics = c("colour", "fill")) +
  scale_x_continuous(expand = c(.01,0)) + 
  labs(title = "Cantidad de Reseñas por pais",
       x = "Reseñas",
       y = "Pais")

Al existir paises con tan pocas reseñas, conviene filtrarlos o agruparlos:

vinos |> 
  filter(!is.na(pais)) |> 
  group_by(pais = fct_lump_prop(pais, 0.001, other_level = "Otros")) |> 
  summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |>
  filter(!is.na(precio_promedio)) |> 
  ggplot(aes(precio_promedio, 
             reorder(pais, precio_promedio))) +
  geom_col(width = 0.5, show.legend = FALSE,
           aes(color=reorder(pais, precio_promedio),
               fill=reorder(pais, precio_promedio),
               alpha = 0.6)) +
  scale_fill_viridis_d(option = "F", 
                       direction = 1, 
                       aesthetics = c("colour", "fill")) +
  scale_x_continuous(expand = c(0.01,0)) + 
    labs(title = "Precio promedio de los vinos por pais",
       subtitle = "Versión resumida",
       x = "Precio", y = "Pais")

Otros = paises con pocas reseñas

(<0,1% del tamaño de la muestra)

Conclusiones: Se constata una diferencia significativa entre los precios promedio según el pais de origen del vino, ya sea contabilizando todos o excluyendo los menos representativos.

Respecto de la cantidad de reseñas, no es posible establecer si es una limitación de la muestra, con mayor acceso o interés en vinos locales (las reseñas de EEUU casi triplican a las del segundo, Francia), si existen menos reseñas por tener menor producción de vino, u otros motivos.

Tampoco es posible determinar los motivos de la variación de precio. Puede suponerse que influya la reputación vitivinícola, el tamaño de las economías (países con economías desarrolladas parecen ocupar los 1ros puestos), u otras causas.

Precio vs Puntaje

Habría una incremento en el precio promedio del vino conforme su puntaje.

Primeramente, se elabora un gráfico de dispersión de la relación puntaje y precio, eliminando vinos de precios muy altos (> 1000), ya que limitan la utilidad el gráfico:

Este gráfico brinda poca información. Parecería que existen vinos de precio bajo en casi todos los puntajes, y el precio mínimo parece elevarse ligeramente a partir del puntaje 95.

p <- vinos |>
  filter(!is.na(puntos)) |> 
  filter(!is.na(precio)) |> 
  filter(precio < 1000) |>
  ggplot(aes(x=puntos, y=precio, color=precio)) +
  geom_jitter(show.legend = FALSE) +
  # scale_color_gradientn(colors = brewer.pal(5, "YlOrBr")) +
  scale_color_viridis_c(option = "F", direction = 1) +
  # scale_color_gradient(low="blue", high="red") + 
  labs(title = "Relación precio-puntaje",
       subtitle = "escala lineal",
       x = "Puntos", y = "Precio (US$)", colour = "Precio")
show(p)

Si cambiamos la escala:

q <- vinos |>
  filter(!is.na(puntos)) |> 
  filter(!is.na(precio)) |> 
  ggplot(aes(x = puntos, y = precio)) +
  scale_y_log10() +
  geom_jitter(aes(colour = precio), show.legend = FALSE) +  # Mover la estética aquí
  scale_color_viridis_c(option = "F", direction = 1, trans = "log") +
  labs(title = "Relación precio-puntaje",
       subtitle = "escala logarítmica",
       x = "Puntos", y = "Precio (US$)") +
  geom_labelsmooth(method = "lm",
                   label = "A mayor puntaje, mayor precio", alpha = 0.5,
                   arrow = arrow())
    # stat_smooth(method = "lm",
    #         formula = y ~ x,
    #         geom = "smooth",
    #         color="black")
show(q)
## `geom_smooth()` using formula = 'y ~ x'

Una escala logarítmica permite apreciar mucho mejor la relación existente entre precio y puntaje.

Vamos a comprobar el precio promedio para cada puntaje:

p <- vinos |>
  filter(!is.na(puntos)) |> 
  filter(!is.na(precio)) |>
  group_by(puntos) |> 
  summarise(precio_promedio = mean(precio, na.rm = TRUE)) |>
  ggplot(aes(x=puntos, y=precio_promedio, fill=precio_promedio)) + 
  geom_col() +
  scale_color_binned(trans = "log") + 
  labs(title = "Precio Promedio vs Puntaje",
       x = "Puntos", y = "Precio (US$)", fill = "Precio (US$)")
show(p)

Con esto se aprecia que el precio promedio de los vino se incrementa, pero el crecimiento sigue una tendencia más exponencial que lineal.

También podemos observar como se distribuyen los puntajes:

vinos |>
  filter(!is.na(puntos)) |> 
  filter(!is.na(precio)) |>
  group_by(puntos) |> 
  summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |> 
  gt() |> 
  tab_header(title = "Relaciones", subtitle = "Puntos vs Precio Promedio vs Reseñas") |> 
  cols_label(puntos = "Puntos", precio_promedio = "Precio Promedio", resenias = "Reseñas") |>
  fmt_number(col = 2, decimals = 2) |> 
  gt_theme_pff()
Relaciones
Puntos vs Precio Promedio vs Reseñas
Puntos Precio Promedio Reseñas
80 16.37 395
81 17.18 680
82 18.87 1772
83 18.24 2886
84 19.31 6099
85 19.95 8902
86 22.13 11745
87 24.90 15767
88 28.69 16014
89 32.17 11324
90 36.91 14361
91 43.22 10564
92 51.04 8871
93 63.11 5935
94 81.44 3449
95 109.24 1406
96 159.29 482
97 207.17 207
98 245.49 69
99 284.21 28
100 485.95 19
 
vinos |>
  filter(!is.na(puntos)) |> 
  filter(!is.na(precio)) |>
  group_by(puntos) |> 
  summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |> 
  ggplot(aes(x = puntos, y = resenias)) +
  geom_col(colour = "violetred4", fill = "violetred4",alpha = 0.3)

Se observa que los puntajes parecerían tene una distribución semejante a la normal.

Por último, para relacionar con la hipótesis 1, comparamos puntaje promedio conforme paises:

vinos |> 
  filter(!is.na(pais)) |> 
  group_by(pais) |> 
  summarise(puntos_promedio = mean(puntos, na.rm = TRUE), resenias = n()) |>
  filter(resenias > tamanio_muestra/1000) |> 
  filter(!is.na(puntos_promedio)) |> 
  ggplot(aes(puntos_promedio, reorder(pais, puntos_promedio))) +
  geom_col(width = 0.5, color='orange',fill='orange', alpha = 0.6) +
  labs(x = "Puntaje", y = "Pais") +
  coord_cartesian(xlim = c(80, 100))

Se ve, que al contrario del precio promedio, el puntaje promedio no parecería tiene mucha variabilidad.

Conclusiones: Entendemos que existe una correlación entre el puntaje y el precio, aunque desconocemos si esto puede deberse a un sesgo de quien evalúa (que podría tender a asignar puntajes altos a vinos caros) o a una efectiva correlación entre calidad y precio, ya que hay muchos vinos de bajo precio con alto puntaje.

Precio/Puntaje x Variedad

Existirían variedades que podrían tener un precio promedio significativamente mayor, pero no así su puntaje.

vinos |> 
  filter(!is.na(variedad)) |> 
  group_by(variedad) |> 
  summarise(puntos_promedio = mean(puntos, na.rm = TRUE),
            precio_promedio = mean(precio, na.rm = TRUE),
            resenias = n()) |> 
  arrange(resenias) |> 
  head(10) |> 
  gt() |> 
  tab_header(title = "Variedades de Vino", subtitle = "Variedades con escasas Reseñas") |> 
  cols_label(variedad = "Variedad",
             puntos_promedio = "Puntaje Promedio",
             precio_promedio = "Precio Promedio",
             resenias = "Reseñas") |>
  gt_theme_pff()
Variedades de Vino
Variedades con escasas Reseñas
Variedad Puntaje Promedio Precio Promedio Reseñas
Aidani 82 27 1
Albanello 86 20 1
Athiri 83 18 1
Babosa Negro 92 45 1
Barbera-Nebbiolo 87 30 1
Biancale 85 18 1
Biancolella 85 26 1
Biancu Gentile 89 NaN 1
Blatina 88 12 1
Blauburger 87 17 1
 
  # kable(col.names = c("Variedad", "Puntaje Promedio", "Precio Promedio", "Reseñas")) |>
  # kable_styling(full_width = FALSE)

Por la cantidad de variedades encontradas (707), y la escasa cantidad de reseñas de muchas, se agrupan en “Otras” las variedades sin una cantidad significativa de reseñas.

vinos |> 
  filter(!is.na(variedad)) |> 
  group_by(variedad = fct_lump_min(variedad, tamanio_muestra/200, other_level = "Otras")) |>
  summarise(puntos_promedio = mean(puntos, na.rm = TRUE),
            precio_promedio = mean(precio, na.rm = TRUE),
            resenias = n()) |>
  ## filter(resenias > tamanio_muestra/200) |> 
  arrange(resenias) |>
  ggplot() +
  geom_col(aes(-puntos_promedio+80, reorder(variedad, precio_promedio)), width = 0.5, color='purple4',fill='purple4', alpha = 0.6) +
  geom_col(aes(precio_promedio, reorder(variedad, precio_promedio)), width = 0.5, color='red4',fill='red4', alpha = 0.6) +
  labs(x = "Puntaje - Precio", y = "Variedad")

Para este gráfico, se opusieron puntaje a la izquierda (escala de 80 a 100) y precio a la derecha.

Conclusiones: Se estima que el gráfico da cuenta de que existe una diferencia del precio promedio de las variedades más reseñadas, pero que este precio no correlaciona (al menos a simple vista) con el puntaje promedio. Lo anterior podría deberse a varias causas. Una hipótesis es que las variedades o cepas podrían tener un precio promedio distinto en base a los costos de su producción, la dificultad específica de su cultivo, tiempo de procesamiento, o su exclusividad, entre otros.